home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / ms_dos / tm / towns.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-08  |  3.2 KB  |  157 lines
  1. unit TOWNS;
  2. { ｔｕｒｂｏ-ｐａｓｃａｌ Ver.5 用include file}
  3.  
  4. interface
  5. uses dos;
  6. const
  7.         Ao=1;Midori=2;Mizuiro=3;   {これは TextColor(iro) のカラーの設定}
  8.         Aka=4;Kiiro=6;Murasaki=5;Shiro=7;
  9.  
  10. type
  11.     Mojiretu16=string[16];
  12.  
  13.     date=record
  14.              year:integer;
  15.              month,day,week,hour,minute,sec,msec:byte;
  16.          end;
  17.  
  18. {    registers = record
  19.         case integer of
  20.            1:(ax,bx,cx,dx,bp,si,di,ds,es,flags:integer);
  21.            2:(al,ah,bl,bh,cl,ch,dl,dh          :byte);
  22.         end;
  23. }
  24.         word = integer;
  25.  
  26. var
  27.   parm_area:array[1..128] of integer;
  28.  
  29. {==================================================================}
  30. (* ＣＤ－ＲＯＭBIOS関係 *)
  31. procedure cd_play(var name:string);
  32. (* グラフィックBIOS関係 *)
  33. (* 時計をサポートするBIOS関係 *)
  34. procedure get_date(var parm_date:date );
  35. {Year(integer),month,day,week,hour,minute,sec,msecを取得する}
  36. function today:mojiretu16;
  37. function youbi:mojiretu16;
  38. function Time:mojiretu16;
  39. {==================================================================}
  40. implementation
  41.  
  42.  
  43. (* グラフィックBIOS関係 *)
  44.  
  45.  
  46. (* 時計をサポートするBIOS関係 *)
  47. procedure Get_date(var parm_date:date);
  48. var
  49.     regs:registers;
  50. begin
  51.      with regs do
  52.        begin
  53.          ah:=$01;
  54.          ds:=seg(parm_date);
  55.          di:=Ofs(parm_date);
  56.          intr($96,regs);
  57.       end;
  58. end;
  59.  
  60. function Today:mojiretu16;
  61. var
  62.     s,t:mojiretu16;
  63.     parm_date:date absolute parm_area;
  64. begin
  65.      Get_date(parm_date);
  66.        s:='';
  67.      with parm_date do
  68.        begin
  69.          str(Year,t);
  70.          s:=s+t+'/';
  71.          str(month,t);
  72.          s:=s+t+'/';
  73.          str(day,t);
  74.          s:=s+t;
  75.      end;
  76.      today:=s;
  77. end;
  78.  
  79.          
  80. function Time:mojiretu16;
  81. var
  82.     s,t:mojiretu16;
  83.     parm_date:date absolute parm_area;
  84. begin
  85.      Get_date(parm_date);
  86.      s:='';
  87.      with parm_date do
  88.        begin
  89.          str(hour,t);
  90.          s:=s+t+':';
  91.          str(minute,t);
  92.          s:=s+t+':';
  93.          str(sec,t);
  94.          s:=s+t+'.';
  95.          str(msec,t);
  96.          s:=s+t;
  97.      end;
  98.      Time:=s;
  99. end;
  100.  
  101. function youbi:mojiretu16;
  102. var
  103.     s:mojiretu16;
  104.     parm_date:date absolute parm_area;
  105. begin
  106.      Get_date(parm_date);
  107.      with parm_date do
  108.        begin
  109.          case week of
  110.             0:s:='日'; 1:s:='月'; 2:s:='火'; 3:s:='水';
  111.             4:s:='木'; 5:s:='金'; 6:s:='土';
  112.          END;
  113.      end;
  114.      youbi:=s;
  115. end;
  116.  
  117. (* ＣＤ－ＲＯＭBIOS関係 *)
  118. procedure cd_play(var name:string);
  119. var
  120.     regs:registers;
  121. begin
  122.      with regs do
  123.        begin
  124.          ah:=$50;
  125.          al:=$c0;
  126.          ch:=$00;
  127.          cl:=$01;
  128.          ds:=seg(name);
  129.          di:=Ofs(name);
  130.          intr($96,regs);
  131.       end;
  132. end;
  133.  
  134. {==================================================================}
  135.  
  136. function B_pos(locate:integer; key,s:string):integer;
  137. var             {s の locate 文字目から key を探してその番号を帰す}
  138.     Dammy:string[255];
  139. begin
  140.     Dammy:=copy(s,locate,length(s)-locate+1);
  141.     If Pos(key,Dammy)=0 then B_Pos:=0
  142.         else B_Pos:=Pos(key,Dammy)+locate-1;
  143. end;
  144.  
  145. function DownSase(s:char):char;{大文字を小文字にするための関数}
  146. Begin
  147.     DownSase:=chr(ord(s)+32);
  148. end;
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155. end.(* of unit *)
  156.  
  157.